home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / SYSTEM~1 / SYSCOL~2.FRM < prev    next >
Text File  |  1997-06-09  |  8KB  |  246 lines
  1. VERSION 5.00
  2. Begin VB.Form SysColorPal 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    ClientHeight    =   780
  6.    ClientLeft      =   4230
  7.    ClientTop       =   4395
  8.    ClientWidth     =   1560
  9.    ControlBox      =   0   'False
  10.    LinkTopic       =   "Form1"
  11.    LockControls    =   -1  'True
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    PaletteMode     =   1  'UseZOrder
  15.    ScaleHeight     =   52
  16.    ScaleMode       =   3  'Pixel
  17.    ScaleWidth      =   104
  18.    ShowInTaskbar   =   0   'False
  19.    Begin VB.VScrollBar VScroll1 
  20.       Height          =   690
  21.       LargeChange     =   9
  22.       Left            =   0
  23.       Max             =   18
  24.       TabIndex        =   0
  25.       Top             =   0
  26.       Width           =   270
  27.    End
  28. End
  29. Attribute VB_Name = "SysColorPal"
  30. Attribute VB_GlobalNameSpace = False
  31. Attribute VB_Creatable = False
  32. Attribute VB_PredeclaredId = True
  33. Attribute VB_Exposed = False
  34. Option Explicit
  35.  
  36. 'System Color Palette 1.0 - (27 Windows System Colors)
  37. 'Created by Randy Russell - June 1997
  38. 'Created using Microsoft Visual Basic 5.0
  39.  
  40. 'If the user clicks or double clicks any color then the
  41. ' SelectedColor and SelectedColorName properties are set
  42. ' and the palette is unloaded.
  43. 'A right click sets SelectedColorName to "" and unloads the palette.
  44.  
  45. 'declare program variables
  46. Dim SysColorNames(26) As String     'array for color names
  47. Dim SysColors(26) As Long           'array for color values
  48. Dim CurTop As Integer               'scroll position
  49. Dim iColor As Integer               'default, cur selected color
  50. Dim CurHighLight As Integer         'currently highlighted color
  51. Dim MyBackColor As Long             'palette background color
  52. Public SelectedColor As Long        'user selected color value
  53. Public SelectedColorName As String  'user selected color name
  54. Const CellDim = 13                  'size of color boxes
  55. Const OffsetY = 16                  'distance between rows
  56. Const DefColor = 6                  'default color value
  57.  
  58. Private Sub DrawCell(CellX As Integer, CellY As Integer, CellWidth As Integer, CellHeight As Integer, CellColor As Long)
  59.  'plot 3d square and fill with current color
  60.  ForeColor = &H808080
  61.  Line (CellX, CellY)-(CellX + CellWidth - 1, CellY)
  62.  Line (CellX, CellY)-(CellX, CellY + CellHeight - 1)
  63.  ForeColor = vbWhite
  64.  Line (CellX, CellY + CellHeight - 1)-(CellX + CellWidth, CellY + CellHeight - 1)
  65.  Line (CellX + CellWidth - 1, CellY)-(CellX + CellWidth - 1, CellY + CellHeight)
  66.  ForeColor = &HC0C0C0
  67.  If ForeColor = CellColor Then ForeColor = &HE0E0E0
  68.  Line (CellX + 1, CellY + CellHeight - 2)-(CellX + CellWidth - 1, CellY + CellHeight - 2)
  69.  Line (CellX + CellWidth - 2, CellY + 1)-(CellX + CellWidth - 2, CellY + CellHeight - 1)
  70.  ForeColor = vbBlack
  71.  Line (CellX + 1, CellY + 1)-(CellX + 1, CellY + CellHeight - 2)
  72.  Line (CellX + 1, CellY + 1)-(CellX + CellWidth - 2, CellY + 1)
  73.  ForeColor = CellColor
  74.  Line (CellX + 2, CellY + 2)-(CellX + CellWidth - 3, CellY + CellHeight - 3), , BF
  75. End Sub
  76.  
  77. Private Sub Form_Activate()
  78.  'refresh colors and redraw to assure that the system colors
  79.  'stored reflect *current* windows system colors
  80.  '*un-comment the next two lines if you plan to leave the palette loaded
  81.  'GetColorValues
  82.  'DrawSysPal CurTop
  83. End Sub
  84.  
  85. Private Sub Form_DblClick()
  86.  'set selection and hide
  87.  SelectedColor = SysColors(iColor)
  88.  SelectedColorName = SysColorNames(iColor)
  89.  Hide
  90. End Sub
  91.  
  92. Private Sub Form_Load()
  93.  'initialize program variables
  94.  GetColorValues
  95.  MyBackColor = vbButtonFace
  96.  CurTop = 0
  97.  
  98.  'set default color values
  99.  iColor = DefColor
  100.  CurHighLight = iColor
  101.  SelectedColor = SysColors(iColor)
  102.  SelectedColorName = SysColorNames(iColor)
  103.  
  104.  'set palette size and location
  105.  Width = 2345 'optimum so no horz scroll needed
  106.  Height = 2270 'setup for 9 visible rows spaced 16 apart + borders
  107.  'Move ((frmSysColors.Width - Width) / 2) + frmSysColors.Left, frmSysColors.Top + 4000
  108.  VScroll1.Top = 0
  109.  VScroll1.Left = 132
  110.  VScroll1.Height = 145
  111.  VScroll1.Width = 18
  112.  BackColor = MyBackColor
  113.  
  114.  'draw palette
  115.  DrawSysPal CurTop
  116. End Sub
  117.  
  118. Private Sub GetColorValues()
  119.   'assign system color names
  120.   SysColorNames(0) = "3DDKShadow"
  121.   SysColorNames(1) = "3DFace"
  122.   SysColorNames(2) = "3DHighlight"
  123.   SysColorNames(3) = "3DLight"
  124.   SysColorNames(4) = "3DShadow"
  125.   SysColorNames(5) = "ActiveBorder"
  126.   SysColorNames(6) = "ActiveTitleBar"
  127.   SysColorNames(7) = "ApplicationWorkspace"
  128.   SysColorNames(8) = "ButtonFace"
  129.   SysColorNames(9) = "ButtonShadow"
  130.   SysColorNames(10) = "ButtonText"
  131.   SysColorNames(11) = "Desktop"
  132.   SysColorNames(12) = "GrayText"
  133.   SysColorNames(13) = "Highlight"
  134.   SysColorNames(14) = "HighlightText"
  135.   SysColorNames(15) = "InactiveBorder"
  136.   SysColorNames(16) = "InactiveCaptionText"
  137.   SysColorNames(17) = "InactiveTitleBar"
  138.   SysColorNames(18) = "InfoBackground"
  139.   SysColorNames(19) = "InfoText"
  140.   SysColorNames(20) = "MenuBar"
  141.   SysColorNames(21) = "MenuText"
  142.   SysColorNames(22) = "ScrollBars"
  143.   SysColorNames(23) = "TitleBarText"
  144.   SysColorNames(24) = "WindowBackground"
  145.   SysColorNames(25) = "WindowFrame"
  146.   SysColorNames(26) = "WindowText"
  147.   'assign system color values
  148.   SysColors(0) = vb3DDKShadow
  149.   SysColors(1) = vb3DFace
  150.   SysColors(2) = vb3DHighlight
  151.   SysColors(3) = vb3DLight
  152.   SysColors(4) = vb3DShadow
  153.   SysColors(5) = vbActiveBorder
  154.   SysColors(6) = vbActiveTitleBar
  155.   SysColors(7) = vbApplicationWorkspace
  156.   SysColors(8) = vbButtonFace
  157.   SysColors(9) = vbButtonShadow
  158.   SysColors(10) = vbButtonText
  159.   SysColors(11) = vbDesktop
  160.   SysColors(12) = vbGrayText
  161.   SysColors(13) = vbHighlight
  162.   SysColors(14) = vbHighlightText
  163.   SysColors(15) = vbInactiveBorder
  164.   SysColors(16) = vbInactiveCaptionText
  165.   SysColors(17) = vbInactiveTitleBar
  166.   SysColors(18) = vbInfoBackground
  167.   SysColors(19) = vbInfoText
  168.   SysColors(20) = vbMenuBar
  169.   SysColors(21) = vbMenuText
  170.   SysColors(22) = vbScrollBars
  171.   SysColors(23) = vbTitleBarText
  172.   SysColors(24) = vbWindowBackground
  173.   SysColors(25) = vbWindowFrame
  174.   SysColors(26) = vbWindowText
  175. End Sub
  176.  
  177. Public Sub DrawSysPal(TopIndex As Integer)
  178. 'declare local variables
  179. Dim i As Integer
  180. Dim j As Integer
  181. Dim px As Integer
  182. Dim py As Integer
  183.  
  184.  'clear palette and validate top row index
  185.  px = 2
  186.  py = 1
  187.  Cls
  188.  If TopIndex > 18 Then TopIndex = 18
  189.  If TopIndex < 0 Then TopIndex = 0
  190.  CurTop = TopIndex
  191.  
  192.  'plot the 9 visible rows
  193.  For i = TopIndex To TopIndex + 8
  194.   DrawCell px, py + 1, CellDim, CellDim, SysColors(i)
  195.   If CurHighLight = i Then
  196.    'draw a filled rect for highlight
  197.    Line (px + CellDim + 2, py - 1)-(VScroll1.Left - 5, py + OffsetY - 2), vbHighlight, BF
  198.    ForeColor = vbHighlightText
  199.   Else
  200.    ForeColor = vbWindowText
  201.   End If
  202.   'position and print color name
  203.   CurrentX = px + CellDim + 3
  204.   CurrentY = py
  205.   Print SysColorNames(i)
  206.   'reset position for next row
  207.   py = py + OffsetY
  208.   px = 2
  209.  Next i
  210.  'add 3d line to seperate scrollbar
  211.  i = VScroll1.Left - 2
  212.  Line (i, 0)-(i, ScaleHeight), vb3DShadow
  213.  Line (i + 1, 0)-(i + 1, ScaleHeight), vb3DHighlight
  214.  Refresh
  215. End Sub
  216.  
  217. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  218. Dim icell As Integer
  219. Dim NewColor As Integer
  220.  'if right button clicked then cancel
  221.  If Button = 2 Then
  222.   SelectedColorName = ""
  223.   Hide
  224.  Else
  225.   'determine selection
  226.   icell = Int(Y / OffsetY)
  227.   NewColor = CurTop + icell
  228.   'if clicked the same color again then repaint
  229.   If NewColor <> iColor Then
  230.   'reset highlight and repaint
  231.    iColor = NewColor
  232.    CurHighLight = iColor
  233.    DrawSysPal CurTop
  234.   End If
  235.   'set selection properties
  236.   SelectedColor = SysColors(NewColor)
  237.   SelectedColorName = SysColorNames(NewColor)
  238.   Hide
  239.  End If
  240. End Sub
  241.  
  242. Private Sub VScroll1_Change()
  243.  'pass current top row value and repaint
  244.  DrawSysPal VScroll1.Value
  245. End Sub
  246.